home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / telecom / 86 / pascal / real.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1986-12-19  |  12.0 KB  |  320 lines
  1. (* procedure to convert reals to strings by Doug Harrison *)
  2. {$M+}
  3. {$E+}
  4. PROGRAM mock;
  5.  
  6.   CONST
  7.  
  8.         {$I A:\GEMCONST.PAS}
  9.  
  10.    TYPE  STR12 = STRING [ 12 ];
  11.  
  12.  
  13.         {$I A:\GEMTYPE.PAS}
  14.  
  15.   {$I A:\GEMSUBS.PAS}
  16.  
  17.  
  18.  
  19. PROCEDURE REAL_TO_STRING (     real_num    : REAL;
  20.                            VAR string_real : STRING;
  21.                                digits      : INTEGER;
  22.                                sci_not     : BOOLEAN );
  23.  
  24. (* real_num    : real number to be converted into a string
  25.    string_real : working variable that also passes string result to caller
  26.    digits      : specifies # of digits to be displayed right of decimal,
  27.                  valid values are 0-11
  28.    sci_not     : flag which determines whether to express in sci. not. or not
  29. *)
  30.  
  31. (* FORMAT of string returned is:
  32.    sci. not.:
  33.               sign ( - or SPACE ), #.#####... , E, sign ( - or nothing ), ##.
  34.    non-sci. not. :
  35.                   sign ( - or SPACE ), ####.####.
  36. *)
  37.  
  38. (* Round-off errors of the nature x.xxxxxxx999 are corrected; consequently,
  39.    any number with a sequence of 3 or more terminal 9's
  40.    is affected, even if this is NOT an artifact. This should rarely be a
  41.    problem. Also, if a number is to be expressed in expanded form, the
  42.    magnitude of the exponent plus the # of digits to be displayed can not
  43.    exceed 8, since LONG_ROUND generates long_ints- size < 2e9. This is not
  44.    too severe a problem since only 11 digits of precision are supported
  45.    anyway. That is, specifying 4 digits for the # 100,000,000.9012 is
  46.    meaningless since the number is rounded to 100,000,000.9 as it becomes
  47.    a REAL. The last digits are unavailable to real_to_string. In such
  48.    cases, no action is performed on the number- it emerges untouched by
  49.    the rounding function. Also, note that the detection of 999 occurs after
  50.    conversion to 1 <= mag_num < 10. Thus, 99,999,999,999 becomes 9.9999999999
  51.    which indicates a rounding error.
  52. *)
  53.  
  54.   LABEL 1;
  55.   TYPE STR1           = STRING [ 1 ];
  56.   VAR   mag_num       : REAL;
  57.         c ,i , j, len,
  58.         start_delete,
  59.         end_delete    : INTEGER;
  60.         sign_exp      : STR1;
  61.         temp          : STRING;
  62.         found         : BOOLEAN;
  63.         last          : ARRAY [ 1..11 ] OF STR1;
  64.  
  65.  
  66.  
  67.   PROCEDURE ADJUST_TO_SPECIFIED_LENGTH;
  68.  
  69.      (* adjusts appearance following rounding *)
  70.  
  71.      VAR dec_pos : INTEGER;
  72.  
  73.      BEGIN
  74.  
  75.         dec_pos := POS ( '.' , string_real );
  76.         WHILE LENGTH ( string_real ) < dec_pos + digits DO
  77.                   string_real := CONCAT ( string_real,'0' );
  78.         WHILE LENGTH ( string_real ) > dec_pos + digits DO
  79.                   DELETE ( string_real , LENGTH ( string_real ) , 1 );
  80.         IF POS ( '.' , string_real ) = LENGTH ( string_real )
  81.         THEN DELETE ( string_real , LENGTH ( string_real ) , 1 );
  82.  
  83.      END; (* adjust_to_specified_length *)
  84.  
  85.   PROCEDURE DO_EXPONENT;
  86.  
  87.      BEGIN
  88.          temp := '';
  89.          IF c >= 30 THEN BEGIN
  90.             temp := '3';
  91.             c := c - 30;
  92.          END;
  93.          IF c >= 20 THEN BEGIN
  94.             temp := '2';
  95.             c := c - 20;
  96.          END;
  97.          IF c >= 10 THEN BEGIN
  98.             temp := '1';
  99.             c := c - 10;
  100.          END;
  101.          temp := CONCAT ( temp , CHR ( c + 48 ) );
  102.          adjust_to_specified_length;
  103.          string_real := CONCAT ( string_real,'E' ,sign_exp,temp );
  104.      END;
  105.  
  106.   PROCEDURE SUCCESSOR ( VAR num : STR1 );
  107.  
  108.      (* used to "increment" a string digit *)
  109.  
  110.      BEGIN
  111.         IF num = '8'
  112.         THEN num := '9';
  113.         IF num = '7'
  114.         THEN num := '8';
  115.         IF num = '6'
  116.         THEN num := '7';
  117.         IF num = '5'
  118.         THEN num := '6';
  119.         IF num = '4'
  120.         THEN num := '5';
  121.         IF num = '3'
  122.         THEN num := '4';
  123.         IF num = '2'
  124.         THEN num := '3';
  125.         IF num = '1'
  126.         THEN num := '2';
  127.         IF num = '0'
  128.         THEN num := '1';
  129.      END; (* SUCCESSOR *)
  130.  
  131.   PROCEDURE REMOVE_9s;
  132.  
  133.      VAR i , j : INTEGER;
  134.      BEGIN
  135.  
  136.               (* Get rid of artifactual "999" generated, if any *)
  137.  
  138.               temp := COPY ( string_real , 4 , 10 );
  139.  
  140.               i := 10;
  141.               found := FALSE;
  142.  
  143.               WHILE ( NOT found ) AND ( i >= 1 ) DO
  144.                   IF temp [ i ] <> '9'
  145.                   THEN found := TRUE
  146.                   ELSE i := i - 1;
  147.               i := i + 1;
  148.  
  149.               IF i <= 8
  150.               THEN BEGIN
  151.  
  152.                       FOR j := 1 TO 10 DO
  153.                           last [ j ] := 'f';
  154.  
  155.                       DELETE ( string_real ,i + 3, LENGTH(string_real)-(i+2) );
  156.                       len := LENGTH ( string_real );
  157.                       FOR i := 1 TO len DO
  158.                           last [ i ] := COPY ( string_real , i , 1 );
  159.                       IF len = 3  (* x.9999999999 *)
  160.                       THEN BEGIN
  161.                              IF last [ 2 ] = '9'
  162.                              THEN BEGIN
  163.                                      last [ 2 ] := '1';
  164.                                      last [ 4 ] := '0';
  165.                                      IF sign_exp = ''
  166.                                     THEN c := c + 1
  167.                                      ELSE c := c - 1;
  168.                                   END
  169.                              ELSE BEGIN
  170.                                      successor ( last [ 2 ] );
  171.                                      last [ 4 ] := '0';
  172.                                   END;
  173.                            END
  174.                       ELSE successor ( last [ len ] ); (* x.xxxx999999 *)
  175.                            (* needn't check here if last[len]=9; it CAN'T be,
  176.                               as it would have been a part of the string of 9's
  177.                             *)
  178.  
  179.                       string_real := '';
  180.                       i := 1;
  181.  
  182.                       WHILE ( last [ i ] <> 'f' ) AND ( i < 11 ) DO
  183.                                                    (* recreate string_real *)
  184.                          BEGIN
  185.                             string_real := CONCAT ( string_real , last [ i ] );
  186.                             i := i + 1;
  187.                          END;
  188.  
  189.               END;
  190.  
  191.      END; (* REMOVE_9s *)
  192.  
  193.   BEGIN (* REAL_TO_STRING *)
  194.  
  195.      IF real_num <> 0.0
  196.      THEN BEGIN
  197.               IF real_num < 0.0            (* sign of number *)
  198.               THEN string_real := '-'
  199.               ELSE string_real := ' ';
  200.  
  201.               IF (( real_num < 1.0 ) AND ( real_num > 0.0 ))  OR
  202.                  (( real_num < 0.0 ) AND ( real_num > -1.0 ))
  203.               THEN sign_exp := '-'
  204.               ELSE sign_exp := '';
  205.  
  206.               mag_num := ABS (real_num);   (* got sign, so work with number
  207.                                               magnitude ! *)
  208.               c := 0;                      (* c counts the number of times the
  209.                                               number can be multiplied or div-
  210.                                               ided by 10 so that finally
  211.                                               1 <= number < 10            *)
  212.               IF mag_num >= 10.0           (* make 1 <= number < 10 *)
  213.               THEN REPEAT
  214.                         mag_num := mag_num / 10.0;
  215.                         c := c+1;
  216.                    UNTIL mag_num < 10.0
  217.               ELSE IF mag_num < 1.0
  218.                    THEN REPEAT
  219.                              mag_num := mag_num * 10.0;
  220.                              c := c+1;
  221.                         UNTIL mag_num >= 1.0;
  222.  
  223.               (* Round mag_num to specified # of digits *)
  224.  
  225.               IF  ( sci_not ) AND ( digits <= 8 )
  226.               THEN mag_num := LONG_ROUND ( mag_num * PwrOfTen ( digits ) ) /
  227.                                          PwrOfTen ( digits );
  228.  
  229.               IF NOT sci_not THEN BEGIN (* Round to spec # digit if possible *)
  230.                  IF (c+digits <= 8) AND
  231.                         ((real_num > 1 ) OR ( real_num < -1)) THEN
  232.                     mag_num := LONG_ROUND (mag_num*PwrOfTen(c+digits)) /
  233.                                          PwrOfTen ( c + digits );
  234.   (* bug fix *)  IF ( real_num < 1 ) AND ( real_num > -1 ) THEN BEGIN
  235.                     IF ( digits-c <= 8 ) AND ( digits-c >= -8 ) THEN BEGIN
  236.                        IF digits-c >= 0 THEN
  237.                           mag_num:= LONG_ROUND (mag_num*PwrOfTen(digits-c)) /
  238.                                                 PwrOfTen ( digits-c )
  239.                        ELSE mag_num := LONG_ROUND (mag_num/
  240.                                         PwrOfTen(ABS(digits-c)))*
  241.                                                    PwrOfTen ( ABS(digits-c) );
  242.                     END;
  243.                     IF mag_num = 0 THEN GOTO 1;
  244.                  END;
  245.               END;
  246.  
  247.               (* reals have 11 digits of precision   *)
  248.               (* convert REAL to a string equivalent *)
  249.  
  250.               FOR i := 1 TO 11 DO
  251.                   BEGIN
  252.                          j := TRUNC (mag_num);  (* apparently if mag_num =
  253.                                                    9.999999 then TRUNC
  254.                                                    returns a value of 10
  255.                                                    but if  mag_num=9.9999999999
  256.                                                    it returns 9- strange!
  257.                                                    So adjust c for this  *)
  258.  (* bug fix *)           IF ( j = 10 ) AND ( i = 1 ) THEN BEGIN
  259.                             IF sign_exp = '' THEN BEGIN
  260.                                string_real := CONCAT (string_real,CHR (1+48));
  261.                                c := c+1;
  262.                             END
  263.                             ELSE BEGIN
  264.                                IF sign_exp = '-' THEN BEGIN
  265.                                   string_real:=CONCAT (string_real,CHR(1+48));
  266.                                   c := c-1;
  267.                                END;
  268.                             END;
  269.                          END
  270.                          ELSE string_real := CONCAT (string_real,CHR (j+48));
  271.                          mag_num := ( mag_num - j ) * 10.0;
  272.                          IF i = 1
  273.                          THEN string_real := CONCAT ( string_real , '.' );
  274.                   END; (* FOR i  *)
  275.  
  276.               remove_9s;
  277.  
  278.               IF NOT sci_not  (* express in expanded form *)
  279.               THEN BEGIN
  280.                  IF sign_exp = '-' THEN BEGIN   (* mag_num < 1, mag_num <> 0 *)
  281.                             temp := COPY ( string_real , 1 , 1 );
  282.                             temp := CONCAT ( temp,'0.' );
  283.                             FOR i := 1 TO c - 1 DO
  284.                                 temp := CONCAT ( temp , '0' );
  285.                             DELETE ( string_real , 1 , 1 );
  286.                             DELETE ( string_real , 2 , 1 );
  287.                             string_real := CONCAT ( temp , string_real );
  288.                             adjust_to_specified_length;
  289.                  END
  290.                  ELSE BEGIN
  291.                             DELETE ( string_real , 3 , 1 );
  292.                             IF ( 3 + c ) > LENGTH ( string_real )
  293.                             THEN FOR i := LENGTH( string_real ) TO ( 2 + c ) DO
  294.                                      string_real := CONCAT ( string_real ,
  295.                                                              '0' );
  296.                             INSERT ( '.' , string_real , 3 + c );
  297.                             adjust_to_specified_length;
  298.                  END;
  299.               END
  300.               ELSE do_exponent;      (* express in scientific notation *)
  301.      END (* begin of first then clause *)
  302.  
  303.      ELSE BEGIN   (* real_num = 0 *)
  304.  
  305.  1:           string_real := ' 0';
  306.               FOR i := 1 to digits DO
  307.                   BEGIN
  308.  
  309.                       IF i = 1
  310.                       THEN string_real := CONCAT ( string_real , '.' );
  311.                       string_real := CONCAT ( string_real , '0' );
  312.  
  313.                   END;
  314.      END;
  315.  
  316.   END; (* REAL_TO_STRING *)
  317.  
  318. BEGIN (* dummy program for modular compilation *)
  319. END.
  320.